home *** CD-ROM | disk | FTP | other *** search
/ Info-Mac 3 / Info_Mac_1994-01.iso / Text Processing / Alpha 5.63 / Tcl / SystemCode / copyRing.tcl < prev    next >
Encoding:
Text File  |  1993-11-11  |  1.3 KB  |  76 lines  |  [TEXT/ALFA]
  1. # Implementation of Emacs's kill ring. This is a paste ring.
  2.  
  3. if {[catch {set renamedRing}]} {
  4.     set renamedRing 1
  5.     rename copy oldCopy
  6.     rename cut oldCut
  7.     rename paste oldPaste
  8. }
  9.  
  10. set ringDepth     10
  11. set ringIn         0
  12. set ringOut         0
  13.  
  14.  
  15. proc copy {} {
  16.     global copyring ringDepth ringIn
  17.     
  18.     set len [expr {[selEnd] - [getPos]}]
  19.     if {!$len} {
  20.         if {[getMark] < [getPos]} {
  21.             set text [getText [getMark] [getPos]]
  22.         } else {
  23.             set text [getText [getPos] [getMark]]
  24.         }
  25.         if {![string length $text]} return
  26.     } else {
  27.         set text [getSelect]
  28.     }
  29.     set copyring([expr {$ringIn % $ringDepth}]) $text
  30.  
  31.     incr ringIn
  32.     
  33.     oldCopy
  34. }
  35.  
  36.  
  37. proc cut {} {
  38.     global copyring ringDepth ringIn
  39.     
  40.     set len [expr {[selEnd] - [getPos]}]
  41.     if {!$len} {
  42.         if {[getMark] < [getPos]} {
  43.             set text [getText [getMark] [getPos]]
  44.         } else {
  45.             set text [getText [getPos] [getMark]]
  46.         }
  47.         if {![string length $text]} return
  48.     } else {
  49.         set text [getSelect]
  50.     }
  51.     set copyring([expr {$ringIn % $ringDepth}]) $text
  52.  
  53.     incr ringIn
  54.     
  55.     oldCut
  56. }
  57.  
  58. proc paste {} {
  59.     global copyring ringDepth ringIn ringOut
  60.     
  61.     set ringOut [expr {($ringIn - 1) % $ringDepth}]
  62.     oldPaste
  63. }
  64.  
  65.     
  66. proc pastePop {} {
  67.     global copyring ringDepth ringIn ringOut
  68.     
  69.     if {!$ringIn} { beep; return}
  70.     
  71.     set ringOut [expr $ringOut-1]
  72.     if {$ringOut < 0} {set ringOut [expr {($ringIn-1) % $ringDepth}]}
  73.     
  74.     replaceText [getPos] [getMark] $copyring($ringOut)
  75. }
  76.